(library (renderer)
  (export render-data)
  (import (rnrs base)
          (only (guile)
                lambda* λ
                current-output-port
                ;; display
                ;; newline
                call-with-output-string)

          (ice-9 exceptions)
          (ice-9 textual-ports)
          (ice-9 pretty-print)
          (ice-9 match)

          (prefix (srfi srfi-1) srfi-1:)
          (prefix (srfi srfi-69) srfi-69:)

          (prefix (logging) log:)))


;; (define element-ends
;;   (srfi-69:alist->hash-table
;;    '((PHASE . "\n")
;;      ())))

(define string-repeat
  (λ (str n)
    (call-with-output-string
      (λ (port)
        (let iter ([repetitions n])
          (cond
           [(= repetitions 0)
            (put-string port "")]
           [else
            (put-string port str)
            (iter (- repetitions 1))]))))))


(define indent-string (string-repeat " " 4))


(define member-recursively
  (lambda* (atom lst #:key (test eq?))
    (cond
     [(null? lst) #f]
     [(pair? (car lst))
      (or (member-recursively atom (car lst) #:test test)
          (member-recursively atom (cdr lst) #:test test))]
     [else
      (cond
       [(test atom (car lst)) lst]
       [else (member-recursively atom (cdr lst) #:test test)])])))


(define multirember-with-equal-proc
  (λ (equal-proc)
    (λ (lst unwanted)
      (let loop ([remaining-list lst])
        (cond
         [(null? remaining-list)
          '()]
         [(equal-proc (car remaining-list) unwanted)
          (loop (cdr remaining-list))]
         [(pair? (car remaining-list))
          (cons (loop (car remaining-list))
                (loop (cdr remaining-list)))]
         [else
          (cons (car remaining-list)
                (loop (cdr remaining-list)))])))))


(define remove-member-recursively
  (lambda* (lst unwanted #:key (test symbol=?))
    ((multirember-with-equal-proc test) lst unwanted)))


(define render-entity
  (lambda* (entity #:key (indentation-level 0))
    (log:debug "rendering entity:" entity)
    (call-with-output-string
      (λ (string-port)
        (let render-iter ([attrs (cdr entity)])
          (log:debug "rendering attributes:" attrs)
           (cond
            [(member-recursively 'ID-ATTRIBUTE attrs #:test symbol=?)
             =>
             (λ (id-attr)
               (log:debug "got id-attr:" id-attr)
               (match id-attr
                 [('ID-ATTRIBUTE _ entity-id)
                  (put-string string-port "id: ")
                  (put-string string-port entity-id)]
                 [_ (error "unrecognized pattern of id attribute" id-attr)])
               (render-iter (remove-member-recursively attrs id-attr #:test equal?)))]
            [else
             "\n"]))))))


;; (define put-nothing
;;   (λ (port)
;;     (put-string port "")))


(define render-data
  (lambda* (data #:key (port (current-output-port)) (indentation-level 0))
    (let-values ([(output remaining-data indentation-level)
                  (match data
                    [() (values "" '() indentation-level)]
                    ;; PHASE tagged data itself is not carrying required
                    ;; data. Required data is inside the PHASE-TAG tagged
                    ;; data. So extract the PHASEs and output nothing.
                    [(('PHASE remaining-data ...))
                     (values ""
                             remaining-data
                             indentation-level)]
                    ;; PHASE-TAG tagged data carries the actual string <phase>,
                    ;; which should be output. Then continue with the remaining
                    ;; data.
                    [(('PHASE-TAG val) remaining-data ...)
                     (values (string-append val " ")
                             remaining-data
                             (+ indentation-level 1))]
                    ;; COMMENT tagged data itself does not carry any important
                    ;; information. The information is inside the enclosed
                    ;; parts.
                    [(('COMMENT _ ('COMMENT-TEXT text)) remaining-data ...)
                     (values (string-append "# " text "\n")
                             remaining-data
                             indentation-level)]

                    ;; Match bound followed by a comment, to avoid breaking the
                    ;; line, when there is a comment and output a break when
                    ;; there is no comment.
                    [(('BOUND-ATTRIBUTE _ val) ('COMMENT start text) remaining-data ...)
                     (values (string-append "bound: " val " ")
                             `((COMMENT ,start ,text) ,@remaining-data)
                             indentation-level)]
                    [(('BOUND-ATTRIBUTE _ ... val) remaining-data ...)
                     (values (string-append "bound: " val "\n")
                             remaining-data
                             indentation-level)]

                    [(('MUSIC-SWITCH
                       ('MUSIC-ATTRIBUTE ('MUSIC-ATTRIBUTE-NAME _)
                                         ('FILENAME filename)))
                      remaining-data ...)
                     (values (string-append (string-repeat indent-string indentation-level)
                                            "music: "
                                            filename
                                            "\n")
                             remaining-data
                             indentation-level)]

                    ;; PHASE-ENTITIES tagged data does not itself contain the
                    ;; relevant data. To avoid problems with the end tag of a
                    ;; phase, the end tag is put into the same list as phase
                    ;; entities.
                    [(('PHASE-ENTITIES entities ...) end-tag)
                     (values ""
                             `(,@entities ,end-tag)
                             indentation-level)]
                    ;; Match phase entities without the end tag.
                    [(('PHASE-ENTITIES entities ...))
                     (values ""
                             `(,@entities)
                             indentation-level)]

                    [(('ENTITY attrs ...) other-entities ...)
                     (values (render-entity `(ENTITY ,attrs) #:indentation-level indentation-level)
                             other-entities
                             indentation-level)]
                    #;[(('ENTITY attrs-before ... ('ID-ATTRIBUTE _ id) attrs-after ...) end-tag)
                     (values (string-append (string-repeat "    " indentation-level)
                                            "id: " id)
                             `((ENTITY ,@attrs-before ,@ attrs-after) ,end-tag)
                             indentation-level)])])

                 ;; (X-COORD-ATTRIBUTE (X-COORD-ATTRIBUTE-NAME "x") "100")
                 ;;               (ENTITY-COMMENT (COMMENT-STARTER "#") (ENTITY-COMMENT-TEXT "milk"))
                 ;;               (RATIO-ATTRIBUTE (RATIO-ATTRIBUTE-NAME "ratio") "1")


      (put-string port output)
      ;; (pretty-print remaining-data #:port port)
      (cond
       [(null? remaining-data) 'done]
       [else
        ;; (display remaining-data) (newline)
        (render-data remaining-data #:port port #:indentation-level indentation-level)]))))
